home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / nan_news / toolkit / pegs.prg < prev    next >
Text File  |  1991-08-15  |  9KB  |  235 lines
  1. /*
  2.  * File......: PEGS.PRG
  3.  * Author....: Greg Lief
  4.  * CIS ID....: 72460,1760
  5.  * Date......: $Date:   15 Aug 1991 23:04:18  $
  6.  * Revision..: $Revision:   1.2  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/pegs.prv  $
  8.  *
  9.  * This function is an original work by Mr. Grump and is placed in the
  10.  * public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   E:/nanfor/src/pegs.prv  $
  16.  * 
  17.  *    Rev 1.2   15 Aug 1991 23:04:18   GLENN
  18.  * Forest Belt proofread/edited/cleaned up doc
  19.  * 
  20.  *    Rev 1.1   14 Jun 1991 19:52:38   GLENN
  21.  * Minor edit to file header
  22.  * 
  23.  *    Rev 1.0   01 Apr 1991 01:02:00   GLENN
  24.  * Nanforum Toolkit
  25.  *
  26.  */
  27.  
  28. /*  $DOC$
  29.  *  $FUNCNAME$
  30.  *     FT_PEGS()
  31.  *  $CATEGORY$
  32.  *     Game
  33.  *  $ONELINER$
  34.  *     FT_PEGS GAME (all work and no play...)
  35.  *  $SYNTAX$
  36.  *     FT_PEGS() -> NIL
  37.  *  $ARGUMENTS$
  38.  *     None
  39.  *  $RETURNS$
  40.  *     NIL
  41.  *  $DESCRIPTION$
  42.  *     This function can be used to alleviate boredom.  The object is to
  43.  *     remove all pegs except one.  This is done by jumping over adjacent
  44.  *     pegs.
  45.  *  $EXAMPLES$
  46.  *     FT_PEGS()
  47.  *  $END$
  48.  */
  49.  
  50. #include "inkey.ch"
  51. #translate SINGLEBOX(<top>, <left>, <bottom>, <right>) => ;
  52.            @ <top>, <left>, <bottom>, <right> BOX "┌─┐│┘─└│ "
  53. #translate DOUBLEBOX(<top>, <left>, <bottom>, <right>) => ;
  54.            @ <top>, <left>, <bottom>, <right> BOX '╔═╗║╝═╚║ '
  55. memvar getlist
  56.  
  57. /*
  58.    here's the board array -- structure of which is:
  59.    board_[xx, 1] = subarray containing box coordinates for this peg
  60.    board_[xx, 2] = subarray containing all adjacent locations
  61.    board_[xx, 3] = subarray containing all target locations
  62.    board_[xx, 4] = is the location occupied or not? .T. = Yes, .F. = No
  63. */
  64. static board_ := { { {0, 29, 2, 34}, {2, 4}, {3, 9}, .T. } , ;
  65.              { {0, 37, 2, 42}, {5}, {10}, .T.}      , ;
  66.              { {0, 45, 2, 50}, {2, 6}, {1, 11}, .T. } , ;
  67.              { {3, 29, 5, 34}, {5, 9}, {6, 16}, .T. } , ;
  68.              { {3, 37, 5, 42}, {10}, {17}, .T. } , ;
  69.              { {3, 45, 5, 50}, {5, 11}, {4, 18}, .T. } , ;
  70.              { {6, 13, 8, 18}, {8, 14}, {9, 21}, .T. } , ;
  71.              { {6, 21, 8, 26}, {9, 15}, {10, 22}, .T. } , ;
  72.              { {6, 29, 8, 34}, {4, 8, 10, 16}, {1, 7, 11, 23}, .T. } , ;
  73.              { {6, 37, 8, 42}, {5, 9, 11, 17}, {2, 8, 12, 24}, .T. } , ;
  74.              { {6, 45, 8, 50}, {6, 10, 12, 18}, {3, 9, 13, 25}, .T. } , ;
  75.              { {6, 53, 8, 58}, {11, 19}, {10, 26}, .T. } , ;
  76.              { {6, 61, 8, 66}, {12, 20}, {11, 27}, .T. } , ;
  77.              { {9, 13, 11, 18}, {15}, {16}, .T. } , ;
  78.              { {9, 21, 11, 26}, {16}, {17}, .T. } , ;
  79.              { {9, 29, 11, 34}, {9, 15, 17, 23}, {4, 14, 18, 28}, .T. } , ;
  80.              { {9, 37, 11, 42}, {10, 16, 18, 24}, {5, 15, 19, 29}, .F. } , ;
  81.              { {9, 45, 11, 50}, {11, 17, 19, 25}, {6, 16, 20, 30}, .T. } , ;
  82.              { {9, 53, 11, 58}, {18}, {17}, .T. } , ;
  83.              { {9, 61, 11, 66}, {19}, {18}, .T. } , ;
  84.              { {12, 13, 14, 18}, {14, 22}, {7, 23}, .T. } , ;
  85.              { {12, 21, 14, 26}, {15, 23}, {8, 24}, .T. } , ;
  86.              { {12, 29, 14, 34}, {16, 22, 24, 28}, {9, 21, 25, 31}, .T. } , ;
  87.              { {12, 37, 14, 42}, {17, 23, 25, 29}, {10, 22, 26, 32}, .T. } , ;
  88.              { {12, 45, 14, 50}, {18, 24, 26, 30}, {11, 23, 27, 33}, .T. } , ;
  89.              { {12, 53, 14, 58}, {19, 25}, {12, 24}, .T. } , ;
  90.              { {12, 61, 14, 66}, {20, 26}, {13, 25}, .T. } , ;
  91.              { {15, 29, 17, 34}, {23, 29}, {16, 30}, .T. } , ;
  92.              { {15, 37, 17, 42}, {24}, {17}, .T. } , ;
  93.              { {15, 45, 17, 50}, {25, 29}, {18, 28}, .T. } , ;
  94.              { {18, 29, 20, 34}, {28, 32}, {23, 33}, .T. } , ;
  95.              { {18, 37, 20, 42}, {29}, {24}, .T. } , ;
  96.              { {18, 45, 20, 50}, {30, 32}, {25, 31}, .T. } }
  97.  
  98. function FT_PEGS
  99. LOCAL XX, MOVE, MPOS, POSSIBLE_, BUFFER, TOPROW, OLDSCORE, MOVE2, ;
  100.       SCANBLOCK, OLDCOLOR := SETCOLOR('w/n'), ;
  101.       oldscrn := savescreen(0, 0, maxrow(), maxcol())
  102. /*
  103.    the following code block is used in conjunction with ASCAN()
  104.    to validate entry when there is more than one possible move
  105. */
  106. scanblock := { | a | a[2] == move2 }
  107. cls
  108. xx := 1
  109. setcolor('w/r')
  110. SINGLEBOX(22, 31, 24, 48)
  111. @ 23, 33 say "Your move:"
  112. aeval(board_, { | a, x | drawbox(x) } )
  113. do while lastkey() != K_ESC .and. moremoves()
  114.    move := 1
  115.    setcolor('w/n')
  116.    @ 23, 44 get move picture '##' range 1, 33
  117.    read
  118.    if move > 0
  119.       do case
  120.          case ! board_[move][4]
  121.             err_msg("No piece at that location")
  122.          otherwise
  123.             possible_ := {}
  124.             for xx := 1 to len(board_[move][2])
  125.                if board_[board_[move][2,xx] ][4] .and. ;
  126.                   ! board_[board_[move][3,xx] ][4]
  127.                   aadd(possible_, { board_[move][2,xx], board_[move][3,xx] })
  128.                endif
  129.             next
  130.             // only one available move -- do it
  131.             do case
  132.                case len(possible_) = 1
  133.                   // clear out original position and the position you jumped over
  134.                   board_[move][4] := board_[possible_[1, 1] ][4] := .F.
  135.                   board_[possible_[1, 2] ][4] := .T.
  136.                   drawbox(move, board_[move])
  137.                   drawbox(possible_[1,1])
  138.                   drawbox(possible_[1,2])
  139.                case len(possible_) = 0
  140.                   err_msg('Illegal move!')
  141.                otherwise
  142.                   move2 := possible_[1, 2]
  143.                   toprow := 21 - len(possible_)
  144.                   setcolor('+w/b')
  145.                   buffer := savescreen(toprow, 55, 22, 74)
  146.                   DOUBLEBOX(toprow, 55, 22, 74)
  147.                   @ toprow, 58 say 'Possible Moves'
  148.                   devpos(toprow, 65)
  149.                   aeval(possible_, { | a | devpos(row()+1, 65), ;
  150.                                            devoutpict(a[2], '##') } )
  151.                   oldscore := set(_SET_SCOREBOARD, .f.)
  152.                   @23, 44 get move2 picture '##' ;
  153.                           valid ascan(possible_, scanblock) > 0
  154.                   read
  155.                   restscreen(toprow, 55, 22, 74, buffer)
  156.                   set(_SET_SCOREBOARD, oldscore)
  157.                   mpos := ascan(possible_, { | a | move2 == a[2] })
  158.                   // clear out original position and the position you jumped over
  159.                   board_[move][4] := board_[possible_[mpos, 1] ][4] := .F.
  160.                   board_[move2][4] := .T.
  161.                   drawbox(move)
  162.                   drawbox(possible_[mpos,1])
  163.                   drawbox(move2)
  164.  
  165.             endcase
  166.       endcase
  167.       move := 1
  168.    endif
  169. enddo
  170. setcolor(oldcolor)
  171. restscreen(0, 0, maxrow(), maxcol(), oldscrn)
  172. return NIL
  173.  
  174. * end function FT_PEGS()
  175. *--------------------------------------------------------------------*
  176.  
  177.  
  178. static function DrawBox(nelement)
  179. setcolor(if(board_[nelement][4], '+w/rb', 'w/n'))
  180. @ board_[nelement][1,1], board_[nelement][1,2], board_[nelement][1,3], ;
  181.   board_[nelement][1,4] box "┌─┐│┘─└│ "
  182. DevPos(board_[nelement][1,1] + 1, board_[nelement][1,2] + 2)
  183. DevOut(ltrim(str(nelement)))
  184. return NIL
  185.  
  186. * end static function DrawBox()
  187. *--------------------------------------------------------------------*
  188.  
  189.  
  190. static function err_msg(msg)
  191. local buffer := savescreen(23, 33, 23, 47)
  192. setcursor(0)
  193. setcolor('+w/r')
  194. @ 23, 33 say msg
  195. inkey(2)
  196. setcursor(1)
  197. restscreen(23, 33, 23, 47, buffer)
  198. return nil
  199.  
  200. * end static function Err_Msg()
  201. *--------------------------------------------------------------------*
  202.  
  203.  
  204. static function moremoves()
  205. local xx, yy, canmove := .f., piecesleft := 0, buffer
  206. for xx := 1 to 33
  207.    for yy := 1 to len(board_[xx][2])
  208.       if board_[xx][4] .and.  ;            // if current location is filled
  209.             board_[board_[xx][2,yy] ][4] .and. ;  // adjacent must be filled
  210.             ! board_[board_[xx][3,yy] ][4]           // target must be empty
  211.          canmove := .t.
  212.          exit
  213.       endif
  214.    next
  215.    // increment number of pieces left
  216.    if board_[xx][4]
  217.       piecesleft++
  218.    endif
  219. next
  220. if ! canmove
  221.    setcolor('+w/b')
  222.    buffer := savescreen(18, 55, 21, 74)
  223.    DOUBLEBOX(18, 55, 21, 74)
  224.    @ 19, 58 say "No more moves!"
  225.    @ 20, 58 say ltrim(str(piecesleft)) + " pieces left"
  226.    inkey(0)
  227.    restscreen(18, 55, 21, 74, buffer)
  228. endif
  229. return canmove
  230.  
  231. * end static function MoreMoves()
  232. *--------------------------------------------------------------------*
  233.  
  234. * eof pegs.prg
  235.